Can we train bees to acquire an MNL?
Zaza Kuo
17th May
Learning curve
download required packages
library(ggpubr)## Loading required package: ggplot2library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(ggplot2)clean up data
dat <- read.csv("~/Documents/GitHub/honours-project/part 2_training.csv")
dat$bee_id <- as.factor(dat$bee_id)
dat$trial <- as.factor(dat$trial)
dat$block <- as.factor(dat$block)
# Divided the data into 2 groups: L->R & R->L
dat.lr <- dat %>% filter(group == "LR")
dat.rl <- dat %>% filter(group == "RL")calculate the mean & sd
LR group
# calculate the mean
dat.lr.mean <- dat.lr %>%
group_by(bee_id, block) %>%
summarize(mean = mean(choice))## `summarise()` has grouped output by 'bee_id'. You can override using the
## `.groups` argument.# calculate trial mean and standard deviation
dat.lr.trial.mean <- dat.lr.mean %>%
group_by(block) %>%
summarise(mean.trial = mean(mean), sd = sd(mean))RL group
# calculate the mean
dat.rl.mean <- dat.rl %>%
group_by(bee_id, block) %>%
summarize(mean = mean(choice))## `summarise()` has grouped output by 'bee_id'. You can override using the
## `.groups` argument.# calculate trial mean and standard deviation
dat.rl.trial.mean <- dat.rl.mean %>%
group_by(block) %>%
summarise(mean.trial = mean(mean), sd = sd(mean))plot learning curves
LR group
learning.curve.lr <- ggplot(dat.lr.mean,
aes(x = block,
y = mean,
group = factor(bee_id)))+ # to group the same flower in different visual systems into one group, so the lines will connect them together.
geom_hline(yintercept = 0.5, linetype = "dashed", colour = "grey") +
geom_jitter(size = 1, alpha = 0.5, width = 0.05, height = 0.005,
shape = dat.lr.mean$bee_id, colour = dat.lr.mean$bee_id) + # optional geom_jitter()
geom_line(size = 0.5, alpha = 0.2, colour = dat.lr.mean$bee_id)+
geom_point(data = dat.lr.mean,
aes(x = "10",
y = dat.lr.trial.mean$mean.trial[1]), size = 2) +
geom_point(data = dat.lr.mean,
aes(x = "20",
y = dat.lr.trial.mean$mean.trial[2]), size = 2) +
geom_point(data = dat.lr.mean,
aes(x = "30",
y = dat.lr.trial.mean$mean.trial[3]), size = 2) +
geom_point(data = dat.lr.mean,
aes(x = "40",
y = dat.lr.trial.mean$mean.trial[4]), size = 2) +
geom_errorbar(data = dat.lr.mean,
aes( x = "10", # specify it is for block 10
ymin = dat.lr.trial.mean$mean.trial[1] - dat.lr.trial.mean$sd[1],
ymax = dat.lr.trial.mean$mean.trial[1] + dat.lr.trial.mean$sd[1]), width = .2) +
geom_errorbar(data = dat.lr.mean,
aes( x = "20",
ymin = dat.lr.trial.mean$mean.trial[2] - dat.lr.trial.mean$sd[2],
ymax = dat.lr.trial.mean$mean.trial[2] + dat.lr.trial.mean$sd[2]), width = .2) +
geom_errorbar(data = dat.lr.mean,
aes( x = "30",
ymin = dat.lr.trial.mean$mean.trial[3] - dat.lr.trial.mean$sd[3],
ymax = dat.lr.trial.mean$mean.trial[3] + dat.lr.trial.mean$sd[3]), width = .2) +
geom_errorbar(data = dat.lr.mean,
aes( x = "40",
ymin = dat.lr.trial.mean$mean.trial[4] - dat.lr.trial.mean$sd[4],
ymax = dat.lr.trial.mean$mean.trial[4] + dat.lr.trial.mean$sd[4]), width = .2) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1, suffix = NULL), limits = c(0,1)) + # suffix = NULL to remove % on the y labels
xlab("Trial") +
ylab("Percentage of correct choice") +
theme(axis.title.x = element_text(size = 12),
axis.text.x = element_text(size = 8, colour = "black"),
axis.title.y = element_text(size = 12, vjust = 1),
axis.text.y = element_text(size = 8, colour = "black")) +
scale_color_gradient() +
theme_classic()
print(learning.curve.lr)
RL group
learning.curve.rl <- ggplot(dat.rl.mean,
aes(x = block,
y = mean,
group = factor(bee_id)))+ # to group the same flower in different visual systems into one group, so the lines will connect them together.
geom_hline(yintercept = 0.5, linetype = "dashed", colour = "grey") +
geom_jitter(size = 1, alpha = 0.5, width = 0.05, height = 0.005,
shape = dat.lr.mean$bee_id, colour = dat.lr.mean$bee_id) + # optional geom_jitter()
geom_line(size = 0.5, alpha = 0.2, colour = dat.rl.mean$bee_id)+
geom_point(data = dat.rl.mean,
aes(x = "10",
y = dat.rl.trial.mean$mean.trial[1]), size = 2) +
geom_point(data = dat.rl.mean,
aes(x = "20",
y = dat.rl.trial.mean$mean.trial[2]), size = 2) +
geom_point(data = dat.rl.mean,
aes(x = "30",
y = dat.rl.trial.mean$mean.trial[3]), size = 2) +
geom_point(data = dat.rl.mean,
aes(x = "40",
y = dat.rl.trial.mean$mean.trial[4]), size = 2) +
geom_errorbar(data = dat.rl.mean,
aes( x = "10", # specify it is for block 10
ymin = dat.rl.trial.mean$mean.trial[1] - dat.rl.trial.mean$sd[1],
ymax = dat.rl.trial.mean$mean.trial[1] + dat.rl.trial.mean$sd[1]), width = .2) +
geom_errorbar(data = dat.rl.mean,
aes( x = "20",
ymin = dat.rl.trial.mean$mean.trial[2] - dat.rl.trial.mean$sd[2],
ymax = dat.rl.trial.mean$mean.trial[2] + dat.rl.trial.mean$sd[2]), width = .2) +
geom_errorbar(data = dat.rl.mean,
aes( x = "30",
ymin = dat.rl.trial.mean$mean.trial[3] - dat.rl.trial.mean$sd[3],
ymax = dat.rl.trial.mean$mean.trial[3] + dat.rl.trial.mean$sd[3]), width = .2) +
geom_errorbar(data = dat.rl.mean,
aes( x = "40",
ymin = dat.rl.trial.mean$mean.trial[4] - dat.rl.trial.mean$sd[4],
ymax = dat.rl.trial.mean$mean.trial[4] + dat.rl.trial.mean$sd[4]), width = .2) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1, suffix = NULL), limits = c(0,1)) + # suffix = NULL to remove % on the y labels
xlab("Trial") +
ylab("Percentage of correct choice") +
theme(axis.title.x = element_text(size = 12),
axis.text.x = element_text(size = 8, colour = "black"),
axis.title.y = element_text(size = 12, vjust = 1),
axis.text.y = element_text(size = 8, colour = "black")) +
theme_classic()
print(learning.curve.rl)
Test Performance
download required packages
library(wesanderson)
library(dplyr)
library(ggplot2)
library(tidyverse)## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──## ✓ tibble 3.1.5 ✓ purrr 0.3.4
## ✓ tidyr 1.1.4 ✓ stringr 1.4.0
## ✓ readr 2.0.2 ✓ forcats 0.5.1## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(stringr)clean up data
dat2 <- read.csv("~/Desktop/experiment/zaza/part 2_testing.csv")
dat2$bee_id <- as.factor(dat2$bee_id)
dat2$trial <- as.factor(dat2$trial)
# Split the data into 2 groups: L->R & R->L
dat2.lr <- dat2 %>% filter(group == "LR")
dat2.rl <- dat2 %>% filter(group == "RL")calculate mean & sd
LR group
# Calculate the mean for each test type and test
dat2.lr.mean <- dat2.lr %>%
group_by(bee_id, test, test_type) %>%
summarise(mean.ind = mean(choice)) %>% # Average for individuals
group_by(test, test_type) %>%
summarise(mean = mean(mean.ind), sd = sd(mean.ind)) %>% # Average for the test type and test
mutate(number_test = ifelse(str_detect(test_type, "S"), "S", "B")) # Create a new column for S/B## `summarise()` has grouped output by 'bee_id', 'test'. You can override using
## the `.groups` argument.
## `summarise()` has grouped output by 'test'. You can override using the
## `.groups` argument.RL group
dat2.rl.mean <- dat2.rl %>%
group_by(bee_id, test, test_type) %>%
summarise(mean.ind = mean(choice)) %>% # Average for individuals
group_by(test, test_type) %>%
summarise(mean = mean(mean.ind), sd = sd(mean.ind)) %>% # Average for the test type and test
mutate(number_test = ifelse(str_detect(test_type, "S"), "S", "B")) # Create a new column for S/B## `summarise()` has grouped output by 'bee_id', 'test'. You can override using
## the `.groups` argument.
## `summarise()` has grouped output by 'test'. You can override using the
## `.groups` argument.plot barplots
LR group
# plot bar plot LR
barplot.lr <- ggplot(dat2.lr.mean, aes(x = test, y = mean, fill = number_test)) +
geom_bar(stat = "identity", position = "dodge") +
geom_errorbar(aes(ymin = mean-sd, ymax = mean+sd), width=.2,
position=position_dodge(.9)) +
xlab("Test") +
ylab("Percentage of correct choice") +
scale_fill_manual(values = wes_palette("GrandBudapest2", n = 2),
name = "Number Test", labels = c("Big number", "Small number")) + # change legend
scale_x_discrete(limits = c("LT","TT"),
labels = c("Learning Test", "Transfer Test")) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1, suffix = NULL), limits = c(0,1)) +
theme_classic() +
geom_hline(yintercept = 0.5, linetype = "dashed", colour = "grey")
print(barplot.lr)
RL group
# plot bar plot RL
barplot.rl <- ggplot(dat2.rl.mean, aes(x = test, y = mean, fill = number_test)) +
geom_bar(stat = "identity", position = "dodge") +
geom_errorbar(aes(ymin = mean-sd, ymax = mean+sd), width=.2,
position=position_dodge(.9)) +
xlab("Test") +
ylab("Percentage of correct choice") +
scale_fill_manual(values = wes_palette("GrandBudapest1", n = 2),
name = "Number Test", labels = c("Big number", "Small number")) +
scale_x_discrete(limits = c("LT","TT"),
labels = c("Learning Test", "Transfer Test")) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1, suffix = NULL), limits = c(0,1)) +
geom_hline(yintercept = 0.5, linetype = "dashed", colour = "grey") +
theme_classic()
print(barplot.rl)
combine two plots
download packages
library(patchwork)combine the learning cuves & barplots
LR group
LR <- learning.curve.lr+barplot.lr
LR + plot_annotation(tag_levels = "A")
RL group
RL <- learning.curve.rl+barplot.rl
RL + plot_annotation(tag_levels = "A")